home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / simple1a / chat.frm next >
Text File  |  1998-07-02  |  5KB  |  174 lines
  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Begin VB.Form frmChat 
  5.    Caption         =   "Chat"
  6.    ClientHeight    =   3915
  7.    ClientLeft      =   165
  8.    ClientTop       =   735
  9.    ClientWidth     =   4590
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   3915
  12.    ScaleWidth      =   4590
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin MSComctlLib.StatusBar sbrChat 
  15.       Align           =   2  'Align Bottom
  16.       Height          =   375
  17.       Left            =   0
  18.       TabIndex        =   1
  19.       Top             =   3540
  20.       Width           =   4590
  21.       _ExtentX        =   8096
  22.       _ExtentY        =   661
  23.       Style           =   1
  24.       _Version        =   393216
  25.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  26.          NumPanels       =   1
  27.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  28.             AutoSize        =   1
  29.             Object.Width           =   7594
  30.          EndProperty
  31.       EndProperty
  32.    End
  33.    Begin MSWinsockLib.Winsock sckTCP 
  34.       Left            =   120
  35.       Top             =   3000
  36.       _ExtentX        =   741
  37.       _ExtentY        =   741
  38.       _Version        =   393216
  39.    End
  40.    Begin VB.TextBox txtChat 
  41.       Height          =   2895
  42.       Left            =   0
  43.       MultiLine       =   -1  'True
  44.       ScrollBars      =   2  'Vertical
  45.       TabIndex        =   0
  46.       Top             =   0
  47.       Width           =   4215
  48.    End
  49.    Begin VB.Menu mnuConnect 
  50.       Caption         =   "&Connect!"
  51.    End
  52.    Begin VB.Menu mnuDisconnect 
  53.       Caption         =   "&Disconnect!"
  54.    End
  55. End
  56. Attribute VB_Name = "frmChat"
  57. Attribute VB_GlobalNameSpace = False
  58. Attribute VB_Creatable = False
  59. Attribute VB_PredeclaredId = True
  60. Attribute VB_Exposed = False
  61. Option Explicit
  62. Dim mlngBytes As Long
  63.  
  64. 'Start out listening for connection
  65. 'requests
  66. Private Sub Form_Load()
  67.     'Set the port to listen on
  68.     sckTCP.LocalPort = 1002
  69.     'Begin listening
  70.     sckTCP.Listen
  71.     'Update status bar
  72.     ShowText "Listening"
  73. End Sub
  74.  
  75. Private Sub Form_Resize()
  76.     txtChat.Width = Me.ScaleWidth
  77.     txtChat.Height = Me.ScaleHeight - sbrChat.Height
  78.     sbrChat.Panels(1).Width = Me.ScaleWidth - 300
  79. End Sub
  80.  
  81. Private Sub mnuConnect_Click()
  82.     Dim strRemoteHost As String
  83.     'Get the name of a computer to connect to
  84.     strRemoteHost = InputBox("Enter name or IP address of computer " & _
  85.         "to connect to.", vbOKCancel)
  86.     'Exit if cancelled
  87.     If strRemoteHost = "" Then Exit Sub
  88.     'Close any open connections
  89.     sckTCP.Close
  90.     'Set the name of the computer to connect to
  91.     sckTCP.RemoteHost = strRemoteHost
  92.     'Specify a port number on remote host
  93.     sckTCP.RemotePort = 1002
  94.     'This seems to prevent some TCP errors
  95.     DoEvents
  96.     'Request the connection
  97.     sckTCP.Connect
  98. End Sub
  99.  
  100. Private Sub mnuDisconnect_Click()
  101.     sckTCP.Close
  102.     DoEvents
  103.     sckTCP.Listen
  104.     ShowText "Listen"
  105. End Sub
  106.  
  107. Private Sub sckTCP_Close()
  108.     ShowText "Close"
  109.     'When connection by remote machine, go back to listening
  110.     sckTCP.Close
  111.     sckTCP.Listen
  112.     ShowText "Listen"
  113. End Sub
  114.  
  115. Private Sub sckTCP_Connect()
  116.     ShowText "Connected"
  117. End Sub
  118.  
  119. Private Sub sckTCP_ConnectionRequest(ByVal requestID As Long)
  120.     sckTCP.Close
  121.     sckTCP.Accept requestID
  122.     ShowText "Accepting request from " & sckTCP.RemoteHostIP
  123. End Sub
  124.  
  125. Private Sub sckTCP_DataArrival(ByVal bytesTotal As Long)
  126.     Dim strText As String
  127.     'Get data
  128.     sckTCP.GetData strText
  129.     'Display data received
  130.     txtChat = txtChat & ">>" & strText & vbCrLf
  131.     'Move cursor to end
  132.     txtChat.SelStart = Len(txtChat)
  133.     ShowText "Bytes received: " & bytesTotal
  134. End Sub
  135.  
  136. 'Display error information
  137. Private Sub sckTCP_Error(ByVal Number As Integer, _
  138.     Description As String, ByVal Scode As Long, _
  139.     ByVal Source As String, ByVal HelpFile As String, _
  140.     ByVal HelpContext As Long, CancelDisplay As Boolean _
  141. )
  142.     ShowText "Error " & Number & " " & Description
  143. End Sub
  144.  
  145. Private Sub sckTCP_SendComplete()
  146.     ShowText "Bytes sent: " & mlngBytes
  147. End Sub
  148.  
  149. Private Sub sckTCP_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
  150.     'Record number of bytes sent
  151.     mlngBytes = bytesSent
  152. End Sub
  153.  
  154. Private Sub txtChat_KeyPress(KeyAscii As Integer)
  155.     Static strSend As String
  156.     'Make sure there is a connection
  157.     If sckTCP.State <> sckConnected Then Exit Sub
  158.     'Send data when user presses Enter
  159.     If KeyAscii = Asc(vbCr) Then
  160.         'Send the string
  161.         sckTCP.SendData strSend
  162.         'Clear the variable
  163.         strSend = ""
  164.     Else
  165.         'Keep track of what is being typed
  166.         strSend = strSend & Chr(KeyAscii)
  167.     End If
  168. End Sub
  169.  
  170. Sub ShowText(Text As String)
  171.     sbrChat.Panels(1).Text = Text
  172. End Sub
  173.  
  174.